﻿Module AllFunctions
    Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Long
    Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFilename As String) As Long
    '--------------------------------写入读取注册表自定义函数-----------------------
    ''' <summary>
    ''' 写入INI文件
    ''' </summary>
    Public Function WriteOneString(ByVal section As String, ByVal key As String, ByVal value As String, ByVal filename As String) As Long
        Dim X As Boolean
        Dim Nbuff As New String(CType(" ", Char), 1000)
        Nbuff = value + Chr(0)
        X = WritePrivateProfileString(section, key, Nbuff, filename)
        WriteOneString = X
    End Function
    ''' <summary>
    ''' 读取INI文件
    ''' </summary>
    Public Function ReadOneString(ByVal section As String, ByVal key As String, ByVal Filename As String) As String
        Dim X As Long, i As Integer

        Dim Buffer As New String(CType(" ", Char), 1000)
        X = GetPrivateProfileString(section, key, "", Buffer, 1000, Filename)
        i = InStr(Buffer, Chr(0))
        ReadOneString = Trim(Left(Buffer, i - 1))
    End Function

    ''' <summary>
    ''' 删除代码中的多余空行
    ''' </summary>
    Sub DelBlankRow()
        '//删除代码中的多余空行
        Dim aCodePane As VBIDE.CodePane
        Dim aLineNumber As Int32
        Dim aLine As String

        aCodePane = _VBE.ActiveCodePane
        For aLineNumber = _VBE.SelectedVBComponent.CodeModule.CountOfLines To 1 Step -1
            aLine = aCodePane.CodeModule.Lines(aLineNumber, 1)

            If Len(Trim(aLine)) = 0 Then
                _VBE.SelectedVBComponent.CodeModule.DeleteLines(aLineNumber, 1)
            End If

        Next aLineNumber
    End Sub

    ' 注释
    ''' <summary>
    ''' 注释光标及最后到代码
    ''' </summary>
    Sub annotation()
        Dim aCodePane As VBIDE.CodePane
        Dim aLineNumber As Int32
        Dim aLine, bLine As String
        Dim StartLine, StartCol, EndLine, EndCol As Long
        _VBE.ActiveCodePane.GetSelection(StartLine, StartCol, EndLine, EndCol)

        ' MsgBox(StartLine & "," & StartCol & "," & EndLine & "," & EndCol)
        aCodePane = _VBE.ActiveCodePane
        For aLineNumber = 1 To aCodePane.CodeModule.CountOfLines
            If aLineNumber >= StartLine And aLineNumber <= EndLine Then
                aLine = aCodePane.CodeModule.Lines(aLineNumber, 1)
                Dim isExitStr As Boolean = InStr(aLine, "'")
                If isExitStr Then
                    bLine = Replace(aLine, "'", "")
                Else
                    bLine = "'" & aLine
                End If

                aCodePane.CodeModule.ReplaceLine(aLineNumber, bLine)
            End If
        Next aLineNumber
    End Sub

    ''' <summary>
    ''' 注释光标当前行代码，未解决
    ''' </summary>
    Sub ZStion()
        Dim aCodePane As VBIDE.CodePane
        Dim aLine, bLine As String
        'Dim StartLine, StartCol, EndLine, EndCol As Long
        '_VBE.ActiveCodePane.GetSelection(StartLine, StartCol, EndLine, EndCol)
        Dim SelInfo As SelLineColInfo = VBGetSelection() '获取光标所在位置
        Dim KeyStr As String = RTrim(_VBE.ActiveCodePane.CodeModule.Lines(SelInfo.SLine, 1)) '获取当前行数据
        aCodePane = _VBE.ActiveCodePane
        aLine = aCodePane.CodeModule.Lines(SelInfo.SLine, 1)
        Dim isExitStr As Boolean = InStr(aLine, "'")
        If isExitStr Then
            bLine = Replace(aLine, "'", "")
        Else
            bLine = "'" & aLine
        End If
        aCodePane.CodeModule.ReplaceLine(SelInfo.SLine, bLine)
    End Sub
    ''' <summary>
    ''' 读取代码库,写入数组和字典，读取代码提示到数据
    ''' </summary>
    Sub ReadExCODE()
        '//读取代码库,写入数组和字典
        '对于新打开的新建文件，没保存，文件会占用被关闭
        ' Dim Codewb As Microsoft.Office.Interop.Excel.Workbook = GetObject(KeyWordPath)
        Dim exapp As New Microsoft.Office.Interop.Excel.Application
        Dim Codewb As Microsoft.Office.Interop.Excel.Workbook
        Try
            Codewb = exapp.Workbooks.Open(KeyWordPath)
            CodeArr = Codewb.Worksheets("CodeList").range("a2:c" & Codewb.Worksheets("CodeList").cells(1000000, 1).end(3).row).value
            Codewb.Close(0)
            For i = 1 To UBound(CodeArr)
                DCodeArr.Add(CodeArr(i, 2), CodeArr(i, 3))
            Next
        Catch ex As Exception

        End Try
    End Sub
    ''' <summary>
    ''' 打开提示表
    ''' </summary>
    Public Sub OpenExCODE()
        Dim exapp As New Microsoft.Office.Interop.Excel.Application
        Dim Codewb As Microsoft.Office.Interop.Excel.Workbook
        Try
            'exapp.Workbooks.Open(KeyWordPath) ' GetObject(KeyWordPath)
            Shell("explorer.exe " & KeyWordPath, 1)
            Dim s = Split(KeyWordPath, "\")
            Dim sr = s(UBound(s))
            Codewb = exapp.Workbooks(sr) ' GetObject(KeyWordPath)
            Codewb.Activate()
        Catch ex As Exception
        End Try
    End Sub

    ''' <summary>
    ''' 打开使用及更新说明
    ''' </summary>
    Public Sub OpenSY使用说明()
        Try
            Shell("explorer.exe " & APPpath & "\更新内容及使用说明.txt", 1)
        Catch ex As Exception
        End Try
    End Sub

    ''' <summary>
    ''' 智能提示开关
    ''' </summary>
    Public Sub ZNTSKG()
        WriteOneString("配置信息", "是否智能缩进", IIf(KeyTip_TN = True, 0, 1), APPpath & "\配置.ini")
        KeyTip_TN = Not KeyTip_TN
    End Sub

    Public Sub Delay(秒数) 'delay 1 等待延时1秒 dealy 0.5 零点5秒
        Dim t, t1
        t = DateAndTime.Timer
        Do
            t1 = DateAndTime.Timer
            If t1 < t Then t1 = 86400 + t1
            System.Windows.Forms.Application.DoEvents()
        Loop Until t1 - 秒数 > t
    End Sub
    'Public Sub FS发送按键(按键码)
    '    ' Static WsShell As Object
    '    'If WsShell Is Nothing Then WsShell = CreateObject("Wscript.Shell")
    '    ' WsShell.SendKeys(按键码)
    '    My.Computer.Keyboard.SendKeys(按键码, True)
    'End Sub
End Module
